home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programmer's Power Pack / Delphi Volume 1.iso / s_to_z / statone / sorter.pas < prev    next >
Pascal/Delphi Source File  |  1996-09-15  |  6KB  |  156 lines
  1. Unit sorter;
  2. {┌──────────────────────────────────────────────────────────────────────────┐
  3.  │ This unit provides a tool for sorting arrays                             │
  4.  │ The array may be of any data type! all you have to do is to provide      │
  5.  │ a 'key function' by which the array elements are compared                │
  6.  │ such key functions are provided for the standard data types              │
  7.  │ You may write your own key functions in order to sort complex data types │
  8.  │ such as records, to reverse the sort order or to create multipile sort   │
  9.  │ keys for record elements.                                                │
  10.  │ Note: the key function must be compiled with $F+ (far calls on)          │
  11.  ├──────────────────────────────────────────────────────────────────────────┤
  12.  │ Written by: Erez Amir CompuServe ID: 100274,701    Fax. (+9723)517-1077  │
  13.  │ May be used freely, as long as this notice is kept!                      │
  14.  ├──────────────────────────────────────────────────────────────────────────┤
  15.  │           M O D I F I C A T I O N    H I S T O R Y                       │
  16.  │                                                                          │
  17.  │ Ver   Date        By             what                                    │
  18.  │ ---   ------      -------------- -------------------------------         │
  19.  │ 1.0   Sep-94      Erez Amir      Written, Debugged                       │
  20.  │ Add your update details here...                                          │
  21.  │                                                                          │
  22.  ├──────────────────────────────────────────────────────────────────────────┤
  23.  │ Examples:                                                                │
  24.  │    /* Simple char array */                                               │
  25.  │    Var a:array[1..m] of char                                             │
  26.  │ ->   Sort(a,n,SizeOf(a[1]),CharComp);                                    │
  27.  │                                                                          │
  28.  │    Type MyRec=Record Month,Day:integer end;                              │
  29.  │         MyRecPtr=^MyRec;                                                 │
  30.  │    Var MyArray: array[1..100] of MyRec;                                  │
  31.  │    /* have to write your oun key */                                      │
  32.  │     Function MyComp(p1,p2:Pointer):Boolean;                              │
  33.  │       Var                                                                │
  34.  │         v1:MyRecPtr absolute p1;                                         │
  35.  │         v2:MyRecPtr absolute p2;                                         │
  36.  │       Begin                                                              │
  37.  │         MyComp:=(V1^.Month>V2^.Month) or                                 │
  38.  │                 (V1^.Month=V2^.Month) and (V1^.Day=V2^.day);             │
  39.  │       End;                                                               │
  40.  │ ->   Sort(MyArray,100,SizeOf(MyRec),MyComp);                             │
  41.  └──────────────────────────────────────────────────────────────────────────┘}
  42. Interface
  43. uses dialogs;
  44. Type
  45.   CompFunc=Function(V1,V2:Pointer):Boolean;
  46.  
  47. Procedure Sort(Var Struct;      { array of any Type }
  48.                Num,             { Number of elements }
  49.                Size:Integer;    { Size of each element ( byte ) }
  50.                Comp:CompFunc);
  51.  
  52. { Basic type compare functions }
  53. Function IntComp(I1,I2:Pointer):Boolean;   far;
  54. Function RealComp(r1,r2:Pointer):Boolean;  far;
  55. Function ByteComp(b1,b2:Pointer):Boolean;  far;
  56. Function CharComp(c1,c2:Pointer):Boolean;  far;
  57. Function StringComp(s1,s2:Pointer):Boolean;far;
  58.  
  59. Implementation
  60.  
  61. Procedure Sort{...};
  62.  
  63.   var
  64.     Temp:Pointer;
  65.     StructBase:Array[0..0] of Byte Absolute Struct;
  66.  
  67.   Function VLoc(n:integer):Pointer;
  68.     { Note that no range check is performed! }
  69.     Begin
  70.       {$R-}
  71.       VLoc:=Addr(structBase[n*Size]);
  72.       {$R+}
  73.     End;
  74.  
  75.   Procedure Swap(n1,n2:Integer);
  76.     { swap two elements }
  77.     Begin
  78.       Move(VLoc(n1)^,Temp^,Size);
  79.       Move(VLoc(n2)^,VLoc(n1)^,Size);
  80.       Move(Temp^,VLoc(n2)^,Size);
  81.     End;
  82.  
  83.   { Quick sort routine }
  84.   Procedure Qsort(l,r:Integer);
  85.     Var
  86.       i,j:Integer;
  87.       Pivot:Pointer;
  88.     Begin
  89.       i:=l;
  90.       j:=r;
  91.       GetMem(Pivot,Size);  { Hopefully, the midpoint}
  92.       Move(Vloc((L+r) div 2)^,Pivot^,Size);
  93.       Repeat
  94.         while Comp(Pivot,Vloc(i)) do inc(i);
  95.         while Comp(Vloc(J),pivot) do Dec(j);
  96.         if i<=j then
  97.           Begin
  98.             Swap(i,j);
  99.             Inc(i);
  100.             Dec(j);
  101.           End;
  102.       until i>j;
  103.       if j>l then Qsort(l,j); { recoursive call }
  104.       if i<r then Qsort(i,r);
  105.       FreeMem(Pivot,Size);
  106.     End;
  107.   begin
  108.     GetMem(Temp,Size);   { Temp is used for swap }
  109.     if num>1 then
  110.       Qsort(0,Num-1);
  111.     FreeMem(Temp,Size);
  112.   end;
  113.  
  114. Function IntComp(I1,I2:Pointer):Boolean;
  115.   Type
  116.     IntPtr=^Integer;
  117.   Var
  118.     v1:IntPtr absolute I1;
  119.     v2:IntPtr absolute I2;
  120.   Begin
  121.       showmessage('in intcomp');
  122.     IntComp:=V1^>V2^;
  123.   End;
  124. Function RealComp(r1,r2:Pointer):Boolean;
  125.   Type
  126.     RealPtr=^Real;
  127.   Var
  128.     v1:RealPtr absolute r1;
  129.     v2:RealPtr absolute r2;
  130.   Begin
  131.     RealComp:=V1^>V2^;
  132.   End;
  133. Function ByteComp(b1,b2:Pointer):Boolean;
  134.   Type
  135.     BytePtr=^Byte;
  136.   Var
  137.     v1:BytePtr absolute b1;
  138.     v2:BytePtr absolute b2;
  139.   Begin
  140.     ByteComp:=V1^>V2^;
  141.   End;
  142. Function CharComp(c1,c2:Pointer):Boolean;
  143.   Begin
  144.     CharComp:=ByteComp(c1,c2); { Byte and char are the same! }
  145.   End;
  146. Function StringComp(s1,s2:Pointer):Boolean;
  147.   Type
  148.     StringPtr=^String;
  149.   Var
  150.     v1:StringPtr absolute s1;
  151.     v2:StringPtr absolute s2;
  152.   Begin
  153.     StringComp:=V1^>V2^;
  154.   End;
  155.  
  156. end.